home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / GFXFX2.ZIP / MINIGAME.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-14  |  9KB  |  347 lines
  1.  
  2. program small_game; { MINIGAME.PAS }
  3. { Small shoot'em'up game (right button=exit!), by Bas van Gaalen }
  4. uses crt,u_vga,u_pal,u_mouse;
  5. const
  6.   playerbullits=50; pbacc=5; pbmaxtime=3;
  7.   compbullits=50; cbmaxtime=10; cbspd=3; compspd=2;
  8.   nofstars=99;
  9. type
  10.   posrec=record x,y:integer; end;
  11.   realposrec=record x,y:real; end;
  12.   starsrec=record x:integer; y,spd,col:byte; end;
  13. var
  14.   pbs:array[0..playerbullits] of posrec;
  15.   pbspd:array[0..playerbullits] of byte;
  16.   cbs,cbdir:array[0..compbullits] of realposrec;
  17.   star:array[0..nofstars] of starsrec;
  18.   bckscr,virscr:pointer;
  19.   score:longint;
  20.   px,py,ppx,ppy:word;
  21.   pbtimer,cbtimer,cenergy,penergy,range,cx,cy,pcx,pcy:integer;
  22.   cxd,cyd:shortint;
  23.  
  24. { move routines ------------------------------------------------------------ }
  25.  
  26. procedure moveplayer;
  27. var i:word;
  28. begin
  29.   ppx:=px; ppy:=py;
  30.   px:=getmousex shr 1; py:=getmousey;
  31.   if px<4 then px:=4 else if px>316 then px:=316;
  32.   if py<4 then py:=4 else if py>196 then py:=196;
  33.   if leftpressed then begin
  34.     dec(pbtimer);
  35.     if pbtimer<0 then begin
  36.       pbtimer:=pbmaxtime;
  37.       i:=0;
  38.       while (i<playerbullits) and (pbs[i].x>0) do inc(i);
  39.       if i<playerbullits then begin
  40.         pbs[i].x:=px;
  41.         pbs[i].y:=py;
  42.         pbspd[i]:=1;
  43.       end;
  44.     end;
  45.   end else pbtimer:=0;
  46. end;
  47.  
  48. procedure movecomputer;
  49. var i:word; rx,ry,difx,dify,big:integer;
  50. begin
  51.   pcx:=cx; pcy:=cy;
  52.   dec(range);
  53.   if range<0 then begin
  54.     range:=random(100);
  55.     case random(8) of
  56.       0:begin cxd:=-1; cyd:=-1; end;
  57.       1:begin cxd:=0; cyd:=-1; end;
  58.       2:begin cxd:=1; cyd:=-1; end;
  59.       3:begin cxd:=1; cyd:=0; end;
  60.       4:begin cxd:=1; cyd:=1; end;
  61.       5:begin cxd:=0; cyd:=1; end;
  62.       6:begin cxd:=-1; cyd:=1; end;
  63.       7:begin cxd:=-1; cyd:=0; end;
  64.     end;
  65.   end;
  66.   inc(cx,cxd*compspd);
  67.   inc(cy,cyd*compspd);
  68.   if cx<4 then begin cx:=4; range:=0; end
  69.   else if cx>316 then begin cx:=316; range:=0; end;
  70.   if cy<4 then begin cy:=4; range:=0; end
  71.   else if cy>196 then begin cy:=196; range:=0; end;
  72.   dec(cbtimer);
  73.   if cbtimer<0 then begin
  74.     cbtimer:=random(cbmaxtime);
  75.     i:=0;
  76.     while (i<compbullits) and (cbs[i].x>0) do inc(i);
  77.     if i<compbullits then begin
  78.       rx:=random(10)-5; ry:=random(10)-5;
  79.       cbs[i].x:=cx;
  80.       cbs[i].y:=cy;
  81.       if cx>(px+rx) then difx:=cx-(px+rx) else difx:=(px+rx)-cx;
  82.       if cy>(py+ry) then dify:=cy-(py+ry) else dify:=(py+ry)-cy;
  83.       if difx>dify then big:=difx else big:=dify;
  84.       if big<>0 then begin
  85.         cbdir[i].x:=cbspd*(difx/big);
  86.         cbdir[i].y:=cbspd*(dify/big);
  87.         if cx>(px+rx) then cbdir[i].x:=-cbdir[i].x;
  88.         if cy>(py+ry) then cbdir[i].y:=-cbdir[i].y;
  89.       end;
  90.     end;
  91.   end;
  92. end;
  93.  
  94. procedure moveplayerbullits;
  95. var i:word;
  96. begin
  97.   for i:=0 to playerbullits do
  98.     if pbs[i].x>0 then begin
  99.       dec(pbs[i].y,pbspd[i]);
  100.       if (pbs[i].y mod pbacc)=0 then inc(pbspd[i]);
  101.       if pbs[i].y<0 then begin
  102.         pbs[i].x:=0; pbs[i].y:=0; pbspd[i]:=0;
  103.       end;
  104.     end;
  105. end;
  106.  
  107. procedure movecompbullits;
  108. var i:word;
  109. begin
  110.   for i:=0 to compbullits do
  111.     if cbs[i].x>0 then begin
  112.       cbs[i].x:=cbs[i].x+cbdir[i].x;
  113.       cbs[i].y:=cbs[i].y+cbdir[i].y;
  114.       if (cbs[i].x<4) or (cbs[i].x>316) or
  115.          (cbs[i].y<4) or (cbs[i].y>196) then begin
  116.         cbs[i].x:=0; cbs[i].y:=0;
  117.         cbdir[i].x:=0; cbdir[i].y:=0;
  118.       end;
  119.     end;
  120. end;
  121.  
  122. procedure movestars;
  123. var i:byte;
  124. begin
  125.   for i:=0 to nofstars do begin
  126.     dec(star[i].x,star[i].spd);
  127.     if star[i].x<0 then
  128.       with star[i] do begin
  129.         x:=319;
  130.         y:=random(200);
  131.         spd:=succ(random(3));
  132.         col:=16+spd;
  133.       end;
  134.   end;
  135. end;
  136.  
  137. { check collisions --------------------------------------------------------- }
  138.  
  139. procedure resetgame;
  140. begin
  141.   fillchar(pbs,sizeof(pbs),0);
  142.   fillchar(pbspd,sizeof(pbspd),0);
  143.   fillchar(cbs,sizeof(cbs),0);
  144.   fillchar(cbdir,sizeof(cbdir),0);
  145.   pbtimer:=pbmaxtime; cbtimer:=random(cbmaxtime);
  146.   cx:=4+random(312); cy:=4+random(192);
  147.   px:=0; py:=0;
  148.   range:=0;
  149.   score:=0;
  150.   cenergy:=100;
  151.   penergy:=100;
  152. end;
  153.  
  154. procedure checkall;
  155. var i:word; dx,dy:integer;
  156. begin
  157.   i:=0; { player bullits hit computer }
  158.   while (i<playerbullits) and (pbs[i].x>0) do begin
  159.     dx:=(cx-pbs[i].x)+3;
  160.     dy:=(cy-pbs[i].y)+3;
  161.     if (dx>=0) and (dx<=6) and
  162.        (dy>=0) and (dy<=6) then begin
  163.       inc(score);
  164.       dec(cenergy);
  165.       if cenergy<0 then begin
  166.         destenation:=ptr($a000,0);
  167.         writetxt('YOU WON',130,96,15);
  168.         destenation:=virscr;
  169.         delay(1000);
  170.         repeat until leftpressed;
  171.         resetgame;
  172.       end;
  173.     end;
  174.     inc(i);
  175.   end;
  176.   i:=0; { computer bullits hit player }
  177.   while (i<compbullits) and (cbs[i].x>0) do begin
  178.     dx:=(px-round(cbs[i].x))+3;
  179.     dy:=(py-round(cbs[i].y))+3;
  180.     if (dx>=0) and (dx<=6) and
  181.        (dy>=0) and (dy<=6) then begin
  182.       dec(penergy);
  183.       if penergy<0 then begin
  184.         destenation:=ptr($a000,0);
  185.         writetxt('GAME OVER!',120,96,15);
  186.         destenation:=virscr;
  187.         delay(1000);
  188.         repeat until leftpressed;
  189.         resetgame;
  190.       end;
  191.     end;
  192.     inc(i);
  193.   end;
  194. end;
  195.  
  196. { draw all stuff to screen ------------------------------------------------- }
  197.  
  198. procedure drawall;
  199. var scorestr:string; lcbx,lcby,i:word;
  200. begin
  201.   for i:=0 to nofstars do putpixel(star[i].x,star[i].y,star[i].col);
  202.   { player }
  203.   putpixel(px,py,15);
  204.   putpixel(px-1,py+1,7);
  205.   putpixel(px+1,py+1,7);
  206.   putpixel(px-2,py+2,8);
  207.   putpixel(px+2,py+2,8);
  208.   { computer }
  209.   putpixel(cx-1,cy-1,8);
  210.   putpixel(cx,cy-1,3);
  211.   putpixel(cx+1,cy-1,8);
  212.   putpixel(cx-1,cy,3);
  213.   putpixel(cx+1,cy,3);
  214.   putpixel(cx-1,cy+1,8);
  215.   putpixel(cx,cy+1,3);
  216.   putpixel(cx+1,cy+1,8);
  217.   { player bullits }
  218.   for i:=0 to playerbullits do
  219.     if pbs[i].x>0 then begin
  220.       putpixel(pbs[i].x,pbs[i].y-2,15);
  221.       putpixel(pbs[i].x,pbs[i].y-1,9);
  222.       putpixel(pbs[i].x,pbs[i].y,1);
  223.     end;
  224.   { computer bullits }
  225.   for i:=0 to compbullits do
  226.     if cbs[i].x>0 then begin
  227.       lcbx:=round(cbs[i].x); lcby:=round(cbs[i].y);
  228.       putpixel(lcbx,lcby,15);
  229.       putpixel(lcbx,lcby+1,4);
  230.       putpixel(lcbx,lcby-1,4);
  231.       putpixel(lcbx+1,lcby,4);
  232.       putpixel(lcbx-1,lcby,4);
  233.     end;
  234.   { score }
  235.   str(score:3,scorestr);
  236.   writetxt(scorestr,10,190,15);
  237.   { penergy-bar }
  238.   for i:=199 downto (199-penergy) do begin
  239.     putpixel(1,i,8);
  240.     putpixel(2,i,15);
  241.     putpixel(3,i,8);
  242.   end;
  243.   { cenergy-bar }
  244.   for i:=199 downto (199-cenergy) do begin
  245.     putpixel(316,i,3);
  246.     putpixel(317,i,15);
  247.     putpixel(318,i,3);
  248.   end;
  249.   vretrace;
  250.   flip(virscr,ptr($a000,0),64000);
  251. end;
  252.  
  253. procedure clearall;
  254. var lcbx,lcby,i,j:word;
  255. begin
  256.   for i:=0 to nofstars do putpixel(star[i].x,star[i].y,0);
  257.   { player }
  258.   putpixel(px,py,0);
  259.   putpixel(px-1,py+1,0);
  260.   putpixel(px+1,py+1,0);
  261.   putpixel(px-2,py+2,0);
  262.   putpixel(px+2,py+2,0);
  263.   { computer }
  264.   putpixel(cx-1,cy-1,0);
  265.   putpixel(cx,cy-1,0);
  266.   putpixel(cx+1,cy-1,0);
  267.   putpixel(cx-1,cy,0);
  268.   putpixel(cx+1,cy,0);
  269.   putpixel(cx-1,cy+1,0);
  270.   putpixel(cx,cy+1,0);
  271.   putpixel(cx+1,cy+1,0);
  272.   { player bullits }
  273.   for i:=0 to playerbullits do
  274.     if pbs[i].x>0 then begin
  275.       putpixel(pbs[i].x,pbs[i].y-2,0);
  276.       putpixel(pbs[i].x,pbs[i].y-1,0);
  277.       putpixel(pbs[i].x,pbs[i].y,0);
  278.     end;
  279.   { computer bullits }
  280.   for i:=0 to compbullits do
  281.     if cbs[i].x>0 then begin
  282.       lcbx:=round(cbs[i].x); lcby:=round(cbs[i].y);
  283.       putpixel(lcbx,lcby,0);
  284.       putpixel(lcbx,lcby+1,0);
  285.       putpixel(lcbx,lcby-1,0);
  286.       putpixel(lcbx+1,lcby,0);
  287.       putpixel(lcbx-1,lcby,0);
  288.     end;
  289.   { score }
  290.   for i:=0 to 7 do for j:=0 to 4*8 do putpixel(10+j,190+i,0);
  291.   { penergy-bar }
  292.   for i:=199 downto 99 do begin
  293.     putpixel(1,i,0);
  294.     putpixel(2,i,0);
  295.     putpixel(3,i,0);
  296.   end;
  297.   { cenergy-bar }
  298.   for i:=199 downto 99 do begin
  299.     putpixel(316,i,0);
  300.     putpixel(317,i,0);
  301.     putpixel(318,i,0);
  302.   end;
  303. end;
  304.  
  305. { main --------------------------------------------------------------------- }
  306.  
  307. var i:byte;
  308. begin
  309.   if not mouseinstalled then begin writeln('Needs mouse!'); halt; end;
  310.   randomize;
  311.   mousesensetivity(20,20);
  312.   usefont:=font8x8;
  313.   setvideo($13);
  314.   getmem(virscr,64000); cls(virscr,64000); destenation:=virscr;
  315.   for i:=0 to 5 do setrgb(16+i,10+i*5,10+i*3,15+i*10);
  316.   for i:=0 to nofstars do
  317.     with star[i] do begin
  318.       x:=random(320);
  319.       y:=random(200);
  320.       spd:=succ(random(3));
  321.       col:=16+spd;
  322.     end;
  323.   resetgame;
  324.   repeat
  325.     moveplayer;
  326.     movecomputer;
  327.     moveplayerbullits;
  328.     movecompbullits;
  329.     movestars;
  330.     checkall;
  331.     drawall;
  332.     clearall;
  333.   until rightpressed;
  334.   freemem(virscr,64000);
  335.   setvideo(u_lm);
  336. end.
  337.  
  338. {
  339.   'features':
  340.   - players autofire is slower than a trigger-happy manual-fire.
  341.   - for computer-player:
  342.     the higher number of bullits and the lower the maxtime, the harder it
  343.     gets for the person-player, and vice-versa, if you know what I mean.
  344.   - You can make it al realy impossible for yourself, it you set:
  345.     compbullits=50, cbmaxtime=5, cbspd=3, for instance.
  346. }
  347.